perm filename FNTSAI.SAI[VIS,HPM]10 blob
sn#390270 filedate 1978-10-25 generic text, type T, neo UTF8
ENTRY FNTSEL,CHRDEP,CHRPED,FCACHE,CHRWID,CHR3X2,CHR3Y4,CHR6X4,CHR1X1;
BEGIN "FNTSAI"
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
DEFINE PCLN=0; comment index of word in a picture file containing
number of scanlines in the picture;
DEFINE PCWD=1; comment number of words in the picture;
DEFINE PCBY=2; comment number of valid bytes in the picture;
DEFINE PCBYA=3; comment no. of bytes including the nulls at the end of lines;
DEFINE LNWD=4; comment no. of words per scanline;
DEFINE LNBY=5; comment no. of valid bytes per scanline;
DEFINE LNBYA=6; comment no. of bytes per scanline, including the nulls;
DEFINE WDBY=7; comment no. of bytes per word;
DEFINE WDBI=8; comment no. of bits containing data in a word;
DEFINE BYBI=9; comment no. of bits per byte;
DEFINE BMAX=10; comment maximum value of a byte;
DEFINE BPTAB=11; comment address of second entry in byte pntr. table;
DEFINE LINTAB=12; comment actual address of the first entry in the row table;
OWN SAFE INTEGER ARRAY FNTAR[0:'177];
OWN SAFE STRING ARRAY FNTNAM[0:'177];
OWN STRING FILNM;
PRELOAD_WITH 0,0,0,0;
OWN SAFE INTEGER ARRAY CBUF[0:3];
PRELOAD_WITH -1,-1;
OWN SAFE INTEGER ARRAY CHO[1:2];
EXTERNAL PROCEDURE ADDEL(REFERENCE INTEGER PIC; INTEGER I,J,VAL);
DEFINE FNTHIG='201;
DEFINE FNTBAS='203;
INTERNAL INTEGER PROCEDURE FNTSEL(INTEGER FNTNUM; STRING FILSPEC;
REFERENCE INTEGER FNTHEAD);
BEGIN "FNTSEL"
INTEGER ICHAN,FOO,IFLAG;
PRSFIL(FILSPEC);
FNTNAM[FNTNUM]←DEVPRS&":"&FILPRS;
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
CHO[2]←-1;
CHO[1]←-1;
FNTAR[FNTNUM]←LOCATION(FNTHEAD);
ICHAN←GETCHAN;
IFLAG←TRUE;
OPEN(ICHAN,DEVPRS,'10,19,0,FOO,FOO,IFLAG);
LOOKUP(ICHAN,FILPRS,IFLAG);
IF IFLAG THEN BEGIN RELEASE(ICHAN); RETURN(-1); END;
ARRYIN(ICHAN,MEMORY[LOCATION(FNTHEAD)+0],'204);
RELEASE(ICHAN);
RETURN(MEMORY[LOCATION(FNTHEAD)+'201]); comment return height of font;
END "FNTSEL";
INTERNAL INTEGER PROCEDURE CHRWID(INTEGER FNTNUM, CHR);
BEGIN
INTEGER ICHAN,FOO,POS,I,J,RASW;
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]) LSH -27;
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS] LSH -27;
END "BUFA";
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
RETURN(RASW);
END;
INTERNAL PROCEDURE FCACHE(REFERENCE INTEGER CHE; INTEGER BFSZ);
BEGIN
CBUF[2]←CBUF[0]←LOCATION(CHE);
CBUF[3]←CBUF[1]←BFSZ;
END;
INTERNAL PROCEDURE CHRDEP(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO, YCOMP(1),XCOMP(1));
BEGIN "CHRDEP"
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO+MEMORY[FNTAR[FNTNUM]+FNTHIG]≥0 ∧ YLO≤MEMORY[LOCATION(PIC)+PCLN]*YCOMP THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
INTEGER NROW,PTQ;
INTEGER ARRAY CHAR[0:(RASW LAND '777777)-2];
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(CHAR[0] ASH -27);
YLO←YLO+((CHAR[0] LSH 9) LSH -27);
NROW←CHAR[0] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,CHAR[1],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,YPA,(XLO+J)%XCOMP,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS];
BEGIN "READ"
INTEGER NROW,PTQ;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(MEMORY[POS+1] ASH -27);
YLO←YLO+((MEMORY[POS+1] LSH 9) LSH -27);
NROW←MEMORY[POS+1] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,MEMORY[POS+2],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,YPA,(XLO+J)%XCOMP,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "BUFA";
END "REAL";
END "CHRDEP";
INTERNAL PROCEDURE CHR3X2(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR3X2"
EXTERNAL PROCEDURE L3X2(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+PCLN]*2 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←(POS MOD 128) STEP -1 UNTIL 1 DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L3X2(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L3X2(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR3X2";
INTERNAL PROCEDURE CHR1X1(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR1X1"
EXTERNAL PROCEDURE L1X1(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+PCLN] THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←(POS MOD 128) STEP -1 UNTIL 1 DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L1X1(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L1X1(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR1X1";
INTERNAL PROCEDURE CHR6X4(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR6X4"
EXTERNAL PROCEDURE L6X4(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+PCLN]*4 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L6X4(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L6X4(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR6X4";
INTERNAL PROCEDURE CHR3Y4(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR3Y4"
EXTERNAL PROCEDURE L3Y4(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+LNBY]*4 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L3Y4(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L3Y4(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR3Y4";
INTERNAL PROCEDURE CHRPED(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO, YCOMP(1),XCOMP(1));
BEGIN "CHRPED"
INTEGER ICHAN,FOO,POS,I,J,RASW,PHI;
PHI←MEMORY[LOCATION(PIC)+PCLN];
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO+MEMORY[FNTAR[FNTNUM]+FNTHIG]≥0 ∧ YLO≤MEMORY[LOCATION(PIC)+LNBY]*YCOMP THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
INTEGER NROW,PTQ;
INTEGER ARRAY CHAR[0:(RASW LAND '777777)-2];
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(CHAR[0] ASH -27);
YLO←YLO+((CHAR[0] LSH 9) LSH -27);
NROW←CHAR[0] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,CHAR[1],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,PHI-(XLO+J)%XCOMP,YPA,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS];
BEGIN "READ"
INTEGER NROW,PTQ;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(MEMORY[POS+1] ASH -27);
YLO←YLO+((MEMORY[POS+1] LSH 9) LSH -27);
NROW←MEMORY[POS+1] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,MEMORY[POS+2],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,PHI-(XLO+J)%XCOMP,YPA,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "BUFA";
END "REAL";
END "CHRPED";
END "FNTSAI";